home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue55 / construc / DRBOBCGI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-02-08  |  4.3 KB  |  165 lines
  1. unit DrBobCGI;
  2. {===================================================================}
  3. { unit DrBobCGI (c) 1999 by Bob Swart (aka Dr.Bob - www.drbob42.com }
  4. { version 1.0 - obtain standard CGI variable values by "value()".   }
  5. { version 2.0 - obtain CGI values, cookies and IP/UserAgent values. }
  6. { version 2.1 - obtain Authorisation values (base64-encoded string) }
  7. {===================================================================}
  8. interface
  9. type
  10.   TRequestMethod = (Unknown,Get,Post);
  11. var
  12.   RequestMethod: TRequestMethod = Unknown;
  13.  
  14. var
  15.   ContentLength: Integer = 0;
  16.   RemoteAddress: String[16] = ''; { IP }
  17.   HttpUserAgent: String[128] = ''; { Browser, OS }
  18.   Authorization: String[255] = ''; { Authorization }
  19.  
  20.   function Value(const Field: ShortString; Convert: Boolean = True): ShortString;
  21.   function CookieValue(const Field: ShortString): ShortString;
  22.  
  23. const
  24.   Data: AnsiString = '';
  25.   
  26. implementation
  27. uses
  28.   Windows, SysUtils;
  29.  
  30.   function _Value(const Field: ShortString;
  31.                   const Data: AnsiString; Sep: Char = '&';
  32.                   Convert: Boolean = True): ShortString;
  33.   { 1998/01/02: check for complete match of Field name }
  34.   { 1999/03/01: do conversion *after* searching fields }
  35.   var
  36.     i: Integer;
  37.     Str: String[3];
  38.     len: Byte absolute Result;
  39.   begin
  40.     len := 0; { Result := '' }
  41.     i := Pos('&'+Field+'=',Data);
  42.     if i = 0 then
  43.     begin
  44.       i := Pos(Field+'=',Data);
  45.       if i > 1 then i := 0
  46.     end
  47.     else Inc(i); { skip '&' }
  48.     if i > 0 then
  49.     begin
  50.       Inc(i,Length(Field)+1);
  51.       while Data[i] <> Sep do
  52.       begin
  53.         Inc(len);
  54.         if (Data[i] = '%') and Convert then // special code
  55.         begin
  56.           Str := '$00';
  57.           Str[2] := Data[i+1];
  58.           Str[3] := Data[i+2];
  59.           Inc(i,2);
  60.           Result[len] := Chr(StrToInt(Str))
  61.         end
  62.         else
  63.           if (Data[i] = ' ') and not Convert then Result[len] := '+'
  64.           else
  65.             Result[len] := Data[i];
  66.         Inc(i)
  67.       end
  68.     end
  69.     else Result := '$' { no javascript }
  70.   end {_Value};
  71. {
  72. const
  73.   Data: AnsiString = '';
  74. }
  75.   function Value(const Field: ShortString; Convert: Boolean = True): ShortString;
  76.   begin
  77.     Result := _Value(Field, Data, '&', Convert)
  78.   end;
  79.  
  80. const
  81.   Cookie: AnsiString = '';
  82.  
  83.   function CookieValue(const Field: ShortString): ShortString;
  84.   begin
  85.     Result := _Value(Field, Cookie, ';');
  86.     if Result = '' then Result := Cookie { debug }
  87.   end;
  88.  
  89. var
  90.   P: PChar;
  91.   i: Integer;
  92.   Str: ShortString;
  93.  
  94. initialization
  95.   P := GetEnvironmentStrings;
  96.   while P^ <> #0 do
  97.   begin
  98.     Str := StrPas(P);
  99.     { writeln(Str); {}
  100.     if Pos('REQUEST_METHOD=',Str) > 0 then
  101.     begin
  102.       Delete(Str,1,Pos('=',Str));
  103.       if Str = 'POST' then RequestMethod := Post
  104.       else
  105.         if Str = 'GET' then RequestMethod := Get
  106.     end;
  107.     if Pos('CONTENT_LENGTH=',Str) = 1 then
  108.     begin
  109.       Delete(Str,1,Pos('=',Str));
  110.       ContentLength := StrToInt(Str)
  111.     end;
  112.     if Pos('QUERY_STRING=',Str) > 0 then
  113.     begin
  114.       Delete(Str,1,Pos('=',Str));
  115.       SetLength(Data,Length(Str)+1);
  116.       Data := Str
  117.     end;
  118.     if Pos('HTTP_COOKIE=',Str) > 0 then
  119.     begin
  120.       Delete(Str,1,Pos('=',Str));
  121.       SetLength(Cookie,Length(Str)+1);
  122.       Cookie := Str
  123.     end
  124.     else
  125.     if Pos('REMOTE_ADDR',Str) = 1 then // TDM #39
  126.     begin
  127.       Delete(Str,1,Pos('=',Str));
  128.       RemoteAddress := Str
  129.     end
  130.     else
  131.     if Pos('HTTP_USER_AGENT',Str) = 1 then // TDM #39
  132.     begin
  133.       Delete(Str,1,Pos('=',Str));
  134.       if Pos(')',Str) > 0 then
  135.         Delete(Str,Pos(')',Str)+1,Length(Str)); {!!}
  136.       HttpUserAgent := Str;
  137.     end
  138.     else
  139.     if (Pos('HTTP_AUTHORIZATION',Str) = 1) or
  140.        (Pos('AUTHORIZATION',Str) = 1) then // TDM #55
  141.     begin
  142.       Delete(Str,1,Pos('=',Str));
  143.       Authorization := Str;
  144.     end;
  145.     Inc(P, StrLen(P)+1)
  146.   end;
  147.   if RequestMethod = Post then
  148.   begin
  149.     SetLength(Data,ContentLength+1);
  150.     for i:=1 to ContentLength do read(Data[i]);
  151.     Data[ContentLength+1] := '&';
  152.   { if IOResult <> 0 then { skip }
  153.   end;
  154.   i := 0;
  155.   while i < Length(Data) do
  156.   begin
  157.     Inc(i);
  158.     if Data[i] = '+' then Data[i] := ' '
  159.   end;
  160.   if i > 0 then Data[i+1] := '&'
  161.            else Data := '&';
  162. finalization
  163.   Data := ''
  164. end.
  165.